Sprite 1984 - 1993/Sprite 1984 - 1993.iso/lib/tex/textyl/textyl.shar4.Z/textyl.shar4

Text File | 1987-08-10 | 64.4 KB | 2,174 lines

#!/bin/sh
# to extract, remove the header and type "sh filename"
if `test ! -d ./src`
then
  mkdir ./src
  echo "mkdir ./src"
fi
if `test ! -s ./src/textyl.pas.ae`
then
echo "writing ./src/textyl.pas.ae"
cat > ./src/textyl.pas.ae << 'E_O_F'
   if (figdepth = 0) then
     begin      (* ---- do the primitive by itself *)
      (* re-transform it to the 4th Quadrant *)
     dvilinepts (x1, y1, x2, y2, h, v);  (* global h and v posit *)
     IPUSH;
     TylLine (x1, y1, x2, y2, thk, vk, patt);
     IPOP;
     end
  else if (figdepth > 0) then
     begin      (* ---- Pack it and stack it *)
     lineitem := NewItem (Aline);
     with lineitem^ do
       begin
       BBlx := minx;     BBby := miny;
       BBrx := maxx;     BBty := maxy;
       lx1 := x1;     ly1 := y1;
       lx2 := x2;    ly2 := y2;
       itemthick := thk;
       itemvec := vk;
       itempatt := patt;
       end;
     pushItem (figdepth, lineitem);
     end
   else if (figdepth < 0) then
     begin      (* ---- just do it right away without any PUSH/POP pair *)
             (* this is the case when we are unpacking a figure for
         *  immediate output
         *)
     TylLine (x1, y1, x2, y2, thk, vk, patt);
     end;
end;  (*  linehandle *)


(* ---   Simple Splines -----*)
{-----------------------------------------------------}
procedure splinehandle (figdepth : integer; scalefact : real;
                        thetype : SplineKind; isclosed : boolean;
            markdiam : integer;
                        var contpts : ControlPoints;
                        nknots : integer;
                        dvih, dviv : ScaledPts; (* possible dvi-offsets *)
                        thk : VThickness; vec : VectKind;
            patt : LineStyle;
                        minx, maxx, miny, maxy : ScaledPts;
                        tx, ty : ScaledPts; sx, sy, r : real);
var midx, midy : ScaledPts;
    splineitem : pItem;
    i : integer;
begin
   midx := (minx + maxx) div 2;
   midy := (miny + maxy) div 2;

   xfmcontpts (contpts, nknots, dvih, dviv, midx, midy,
                scalefact, r, tx, ty, sx, sy);

   if (figdepth = 0) then
     begin      (* ----  do the primitive *)
     (* transform to 4th quad *)
     dvicontpts (contpts, nknots, h, v);
     IPUSH;
     TylSpline (thetype, isclosed, contpts, nknots, thk, vec, patt, markdiam);
     IPOP;
     end
   else if (figdepth > 0) then
     begin
     splineitem := NewItem (Aspline);
     with splineitem^ do
       begin
       BBlx := minx; BBby := miny;
       BBrx := maxx; BBty := maxy;
       itemthick := thk;
       itemvec := vec;
       itempatt := patt;
       nsplknots := nknots;
       spltype := thetype;
       sclosed := isclosed;
       dosmarks := markdiam;
       for i := 1 to nknots do
         begin
         spts[i,1] := contpts[i,1];
         spts[i,2] := contpts[i,2];
         end;
       end;
     pushItem (figdepth, splineitem);
     end
   else if (figdepth < 0) then
     begin
     TylSpline (thetype, isclosed, contpts, nknots, thk, vec, patt, markdiam);
     end;
end;  (*  splinehandle *)


(* --- Variable thickness splines ----- *)
{-----------------------------------------------------}
procedure ttsplhandle (figdepth : integer; scalefact : real;
                        thetype : SplineKind; isclosed : boolean;
            markdiam : integer;
                        contpts : ControlPoints;
                        ttks : ThickAryType;
                        nknots : integer;
                        dvih, dviv : ScaledPts; (* possible dvi-offsets *)
                        vec : VectKind;
            patt : LineStyle;
                        minx, maxx, miny, maxy : ScaledPts;
                        tx, ty : ScaledPts; sx, sy, r : real);
var midx, midy : ScaledPts;
    ttsplitem : pItem;
    i : integer;
begin
   midx := (minx + maxx) div 2;
   midy := (miny + maxy) div 2;

   xfmcontpts (contpts, nknots, dvih, dviv, midx, midy,
                scalefact, r, tx, ty, sx, sy);

   if (figdepth = 0) then
     begin
     (* transform to 4th quad      *)
     dvicontpts (contpts, nknots, h, v);
     IPUSH;
     TylThickThinSpline (thetype, isclosed, contpts, ttks, nknots, vec, patt, markdiam);
     IPOP;
     end
   else if (figdepth > 0) then
     begin
     ttsplitem := NewItem (Attspline);
     with ttsplitem^ do
       begin
       BBlx := minx; BBby := miny;
       BBrx := maxx; BBty := maxy;
       itemvec := vec;
       itempatt := patt;
       nttknots := nknots;
       tspltype := thetype;
       dottmarks := markdiam;
       tclosed := isclosed;
       for i := 1 to nknots do
         begin
         ttpts[i,1] := contpts[i,1];
         ttpts[i,2] := contpts[i,2];
         ttarry[i] := ttks[i];
         end;
       end;  (*  ttsplitem *)
     pushItem (figdepth, ttsplitem);
     end
   else if (figdepth < 0) then
     begin
     TylThickThinSpline (thetype, isclosed, contpts, ttks, nknots, vec, patt, markdiam);
     end;

end;  (*  ttsplhandle *)


(* ---- Musical Beams ---- *)
{-----------------------------------------------------}
procedure beamhandle (depth, siz : integer; bk : BeamKind;
                        x1, y1, x2, y2 : ScaledPts);
var bmitem : pItem;
begin
    if (depth = 0) then
      begin
      dvilinepts (x1, y1, x2, y2, h, v);
      IPUSH;
      TylBeam (x1, y1, x2, y2, siz, bk);
      IPOP;
      end
    else if (depth > 0) then
      begin
      bmitem := NewItem (Abeam);
      with bmitem^ do
        begin
        BBlx := min(x1, x2);     BBby := min(y1, y2);
        BBrx := max(x1, x2);     BBty := max(y1, y2);
    bx1 := x1;        by1 := y1;
    bx2 := x2;        by2 := y2;
        staf := siz;
        bkind := bk;
        end;  (* with *)
      pushItem (depth, bmitem);
      end
    else if (depth < 0) then
      begin
      TylBeam (x1, y1, x2, y2, siz, bk);
      end;  (* else *)
end;  (*  beamhandle *)


(* ---- Musical Ties and Slurs ----- *)
{-----------------------------------------------------}
procedure tieslurhandle (depth: integer; pts : ControlPoints;
                        numk : integer; minthick, maxthick : VThickness);
var tsitem : pItem;
    i : integer;
begin
if (depth = 0) then
   begin
     dvicontpts (pts, numk, h, v);
     IPUSH;
     TylTieSlur (pts, numk, minthick, maxthick);
     IPOP;
   end
else if (depth > 0) then
 begin
  tsitem := NewItem (Atieslur);
  with tsitem^ do
    begin
    ntknots := numk;
    for i := 1 to numk do
      begin
      tspts[i,1] := pts[i,1];
      tspts[i,2] := pts[i,2];
      end;
    minth := minthick;
    maxth := maxthick;
    end;  (* with *)
  pushItem (depth, tsitem);
  end
else if (depth < 0) then
  begin
  TylTieSlur (pts, numk, minthick, maxthick);
  end;  (* else *)
end;  (*  tieslurhandle *)


{---------------------------------------------------------}
procedure arccirclehandle (figdepth : integer; scalefact : real;
            cx, cy : ScaledPts;
            radius : ScaledPts;
            ang1, ang2 : integer;
            var contpts : ControlPoints; (* IN *)
            nknots : integer;
            dvih, dviv : ScaledPts; (* possible dvi-offsets *)
            thk : VThickness; vec : VectKind;
            patt : LineStyle;
            minx, maxx, miny, maxy : ScaledPts;
            tx, ty : ScaledPts; sx, sy, r : real);

var midx, midy : ScaledPts;
    middlex, middley : ScaledPts;
    arcitem : pItem;
    i : integer;
    isclosedarc : boolean;

begin
   midx := cx;  middlex := (minx + maxx) div 2;
   midy := cy;    middley := (miny + maxy) div 2;
   isclosedarc := (ang1 = ang2);
{
   if (isclosedarc) then
     maxspanlen := round ((360.0 / 16.0) * DEGTORAD * radius)
   else
     maxspanlen := round ((abs(ang2 - ang1) / 16.0) * DEGTORAD * radius);
{ }


   xfmcontpts (contpts, nknots+1, dvih, dviv, midx, midy,
                scalefact, r, tx, ty, sx, sy);

   if (figdepth = 0) then
     begin      (* ---- just do the primitive *)
     (* transform to 4th quad *)
     dvicontpts (contpts, nknots+1, h, v);
     IPUSH;
     doTylArc (isclosedarc,
             contpts, nknots, thk, vec, patt);
     IPOP;
     end
   else if (figdepth > 0) then
     begin
     arcitem := NewItem (Aarc);
     with arcitem^ do
       begin
       BBlx := minx; BBby := miny;
       BBrx := maxx; BBty := maxy;
       itemthick := thk;
       itemvec := vec;
       itempatt := patt;
       narcknots := nknots;
       acentx := cx;
       acenty := cy;
       aradius := radius;
       firstang := ang1;
       lastang := ang2;
       for i := 0 to nknots+1 do
         begin
         arcpts[i,1] := contpts[i,1];
         arcpts[i,2] := contpts[i,2];
         end;
       end;
     pushItem (figdepth, arcitem);
     end
   else if (figdepth < 0) then
     begin
     doTylArc (isclosedarc, contpts, nknots, thk, vec, patt);
     end;
end;  (*  arccirclehandle *)



{---------------------------------------------------------}
procedure labelhandle (depth : integer; scalefact: real;
                       lax, lay : ScaledPts;
                       dvih, dviv : ScaledPts; (* possible dvi-offsets *)
               style : integer;
               phrase : strng;
               tx, ty : ScaledPts);
var labitem : pItem;
    null1, null2 : ScaledPts;
begin
(* xfm the label point if necessary *)
  lax := lax + round(tx * scalefact);
  lay := lay + round(ty * scalefact);

  if (depth = 0) then
    begin
    null1 := 0; null2 := 0;
    dvilinepts (lax, lay, null1, null2, h, v);
    IPUSH;
    TylLabel (lax, lay, style, phrase.str, phrase.len);
    IPOP;
    end
  else if (depth > 0) then
    begin
    labitem := NewItem (Alabel);
    with labitem^ do
      begin
      labx := lax;
      laby := lay;
      fontstyle := style;
      strcopy (phrase.str, labeltext.str, phrase.len);
      labeltext.len := phrase.len;
      end;
    pushItem (depth, labitem);
    end
  else if (depth < 0) then
    begin
    TylLabel (lax, lay, style, phrase.str, phrase.len);
    end;
end;


(* ####   Insert new handlers here for new "primitives"
    i.e., names callable from the \special[tyl ...]  level
*)



{----------------------------------------------------------------}
(*  transform the current bbox coordinates, and output the new one *)
procedure newbbox (var minx, maxx, miny, maxy : ScaledPts;
                   midx, midy : ScaledPts;
                   sx, sy, rot : real; tx, ty : ScaledPts);
var
      (* coords of full bbox for transformation [n/s][e/w][x/y] *)
   nex, ney, sex, sey, swx, swy, nwx, nwy: ScaledPts;
   temp1, temp2 : integer;
begin
  (* describe  and transform the bbox *)
  nwx := round (minx * sx);      nex := round (maxx * sx);
  sex := round (maxx * sx);      swx := round (minx * sx);
  ney := round (maxy * sy);      nwy := round (maxy * sy);
  swy := round (miny * sy);      sey := round (miny * sy);

  ptrotate (nex, ney, midx, midy, rot);
  ptrotate (sex, sey, midx, midy, rot);
  ptrotate (swx, swy, midx, midy, rot);
  ptrotate (nwx, nwy, midx, midy, rot);

  nex := nex + tx; sex := sex + tx;
  swx := swx + tx; nwx := nwx + tx;
  ney := ney + ty; sey := sey + ty;
  swy := swy + ty; nwy := nwy + ty;
  (* now find the actual extents of the bbox *)
  temp1 := min (nex, nwx);
  temp2 := min (swx, sex);
  minx := min (temp1, temp2);

  temp1 := min (ney, nwy);
  temp2 := min (swy, sey);
  miny := min (temp1, temp2);

  temp1 := max (nex, nwx);
  temp2 := max (swx, sex);
  maxx := max (temp1, temp2);

  temp1 := max (ney, nwy);
  temp2 := max (swy, sey);
  maxy := max (temp1, temp2);
end;


{-----------------------------------------------}
(* find the bounding box of the list of primitives
    and/or sub-figures in this Item *)

procedure findBBox (blot : pItem;
                var mnx, mxx, mny, mxy : ScaledPts);
var
   pi : pItem;
   bmnx, bmxx, bmny, bmxy, midx, midy : ScaledPts; (* bbox [min/max][x/y] *)
   tmnx, tmxx, tmny, tmxy : ScaledPts;  (* temporary, in case of recursion *)
   null1, null2 : ScaledPts;
   prescale, postscale : real;
   old1, old2 : ScaledPts;
begin
  bmnx := TWO24; bmny := TWO24;
  bmxx := -TWO24; bmxy :=-TWO24;
  if (blot^.kind = Afigure) then
    begin (* afigure *)
    pi := blot^.body^.things;
    while (pi <> nil) do
      begin (* find the current bbox of the list of items here *)
      if (pi^.kind = Afigure) then
        begin  (* recur *)
        findBBox (pi, tmnx, tmxx, tmny, tmxy);
        bmnx := min (bmnx, tmnx);
        bmny := min (bmny, tmny);
        bmxx := max (bmxx, tmxx);
        bmxy := max (bmxy, tmxy);
        end
      else
        begin
        bmnx := min (bmnx, pi^.BBlx);
        bmny := min (bmny, pi^.BBby);
        bmxx := max (bmxx, pi^.BBrx);
        bmxy := max (bmxy, pi^.BBty);
        end;
      pi := pi^.nextitem;
      end;  (* while *)
        (* now transform the items inside, AND the bbox *)
    pi := blot^.body^.things;
    midx := (bmnx + bmxx) div 2;
    midy := (bmny + bmxy) div 2;
    (* now take care of any pre and post size requirements *)
    (* see also the "figurehandle" proc. *)
     with blot^ do
      begin
(* ### Keep this scaling biz here, too, for now. May blast it later *)
      if ((preWid <> 0) and (preHt <> 0)) then
    begin
    prescale := scalefitfactor ((bmxx - bmnx), (bmxy - bmny), preWid, preHt);
    fsx := fsx * prescale;
    fsy := fsy * prescale;
    end;
      if ((postWid <> 0) and (postHt <> 0)) then
    begin
    postscale := scalefitfactor ((bmxx - bmnx), (bmxy - bmny), postWid, postHt);
    fsx := fsx * postscale;
    fsy := fsy * postscale;
    end;

(* the actual scale-up is taken care of later in this proc. *)
      end; (* with *)
    while (pi <> nil) do
      begin
      with pi^ do
        begin
        case (kind) of
          Aline : begin
                  xfmlinepts (lx1, ly1, lx2, ly2, 0, 0, midx, midy, 1.0,
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);
                  end;
          Aspline : begin
                    xfmcontpts (spts, nsplknots, 0, 0, midx, midy, 1.0,
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);
                    end;
          Attspline : begin
                      xfmcontpts (ttpts, nttknots, 0, 0, midx, midy, 1.0,
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);
                      end;
      Aarc : begin
         null1 := 0; null2 := 0;
         old1 := acentx; old2 := acenty;
           xfmlinepts (acentx, acenty, null1, null2, 0,0, midx, midy, 1.0,
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);
           xfmcontpts (arcpts, narcknots + 1, 0, 0, old1, old2, 1.0,
                        blot^.figtheta,
            blot^.fdx + (acentx - old1),
            blot^.fdy + (acenty - old2),
                        blot^.fsx, blot^.fsy);
                 end;
      Alabel : begin
           null1 := 0; null2 := 0;
             xfmlinepts (labx, laby, null1, null2, 0,0, midx, midy, 1.0,
                        blot^.figtheta, blot^.fdx, blot^.fdy,
                        blot^.fsx, blot^.fsy);
           end;
          Abeam : ;   (* not transformable *)

          Atieslur: ; (* not transformable *)
          Afigure : ; (* do not need to re-transform *)
        end; (* case *)
      end; (* with *)
      pi := pi^.nextitem;
      end;  (* while *)
    (* transform the bbox, and re-find the new bbox *)
    newbbox (bmnx, bmxx, bmny, bmxy, midx, midy, blot^.fsx, blot^.fsy,
                blot^.figtheta, blot^.fdx, blot^.fdy);
    mnx := bmnx; mny := bmny;
    mxx := bmxx; mxy := bmxy;
    end  (* if *)
  else (* some other primitive *)
    begin
    mnx := blot^.BBlx; mny := blot^.BBby;
    mxx := blot^.BBrx; mxy := blot^.BBty;
    end;  (* else *)
end;  (*  findBBox *)


{---------------------------------------------------------}
(* traverse the list, determining the current bounding box for
 *       the items. We need this to find the mid-point
 *       for doing any remaining rotations
 *)
procedure traverse (thefig, theitem : pItem);
var
    minx, maxx, miny, maxy : ScaledPts;
    curminx, curmaxx, curminy, curmaxy : ScaledPts;
begin
  minx := TWO24; maxx := -TWO24;
  miny := TWO24; maxy := -TWO24;

  while (theitem <> nil) do
    begin
    if (theitem^.kind = Afigure) then
      begin (* recur *)
      findBBox (theitem, curminx, curmaxx, curminy, curmaxy);
      with theitem^ do
        begin
        BBlx := curminx;         BBby := curminy;
        BBrx := curmaxx;         BBty := curmaxy;
           (* reset the symbol's parameters since all the
                primitives in it have now been transformed
                according to the previous specifications *)
        figtheta := 0.0;
        fsx := 1.0;      fsy := 1.0;
        fdx := 0;        fdy := 0;
    preWid := 0;     preHt := 0;
    postWid := 0;     postHt := 0;
        end;  (* with *)
      minx := min (minx, curminx);      miny := min (miny, curminy);
      maxx := max (maxx, curmaxx);      maxy := max (maxy, curmaxy);
      end  (* if a figure/symbol*)
    else
      begin  (* a primitive *)
      with theitem^ do
        begin
        minx := min (minx, BBlx);        miny := min (miny, BBby);
        maxx := max (maxx, BBrx);        maxy := max (maxy, BBty);
        end;  (* with *)
      end;  (* else *)
    theitem := theitem^.nextitem;
    end;  (* while *)

  with thefig^ do
    begin  (* set the bounding box for this upper-level symbol defn *)
    BBlx := minx;
    BBby := miny;
    BBrx := maxx;
    BBty := maxy;
    end;  (* with *)
end;  (* traverse *)

(* ----- Figure symbols ----- *)
{---------------------------------------------------}
procedure figurehandle (globalsymlist, symbollist : pItem; dopush : integer);
const DoItNow = -1;
      NoScale = 1;
var pi, curfig : pItem;
    midx, midy : ScaledPts;
    null1, null2 : ScaledPts;
    prescale, postscale : real;
    tmnx, tmny, tmxx, tmxy : ScaledPts;
begin (* figurehandle *)

    (* PUSH. traverse the lists (recursively if necessary) and
     * compute the transformed points.
     * Convert to 4th quadrant and offset by H & V.
     * We can do this destructively here
     * since we're going to output them right away anyhow.
     * Then call each respective primitive handler with a level
     * of -1 to indicate  to do its job immediately.
     * POP.
     *)
  curfig := symbollist;
  pi := curfig^.body^.things;
        (* find and set the bounding box for
         the figure's sub-symbols and primitives *)
  if (dopush > 0) then
    traverse (curfig, pi);

      (* We eventually transform the items
     to 4th Quadrant DVI space and output them! *)

  pi := curfig^.body^.things;

  midy := (globalsymlist^.BBby + globalsymlist^.BBty) div 2;
  midx := (globalsymlist^.BBlx + globalsymlist^.BBrx) div 2;

  if (dopush > 0) then
    begin (* the top-level figure for outputting *)

    (* convert the bounding box because we are about to enter
        into DVI space, and all calls to handlers hereafter
    are in terms of DVI coordinates *)

      with globalsymlist^ do
        begin

(* Since there were external specifications about this figure,
    fit the current figure's actual size to the
    "pre" size (specified by W marker) and/or to the
    "post" size (specified by the F marker).
    We do this by simple scaling, *without* changing the midpoint
    of the bounding box, just its extents
 *)
    if ((preWid <> 0) and (preHt <> 0)) then
      begin
      prescale := scalefitfactor ((BBrx - BBlx), (BBty - BBby), preWid, preHt);
      fsx := fsx * prescale;
      fsy := fsy * prescale;
      end;
    if ((postWid <> 0) and (postHt <> 0)) then
      begin
      postscale := scalefitfactor ((BBrx - BBlx), (BBty - BBby), postWid, postHt);
      fsx := fsx * postscale;
      fsy := fsy * postscale;
      end;
    tmnx := BBlx; tmny := BBby; tmxx := BBrx; tmxy := BBty;
    xfmlinepts (tmnx, tmny, tmxx, tmxy, 0,0, midx, midy, 1.0,
            0.0, 0, 0, fsx, fsy);

    toplevelxfm (globalsymlist, globalsymlist, 0);

    dviBBlx := tmnx;
    dviBBrx := tmxx;
    dviBBby := tmny;
    dviBBty := tmxy;

    xfmlinepts (dviBBlx, dviBBby, dviBBrx, dviBBty, 0,0,
        midx, midy, 1.0, 0.0,
        - (tmnx - BBlx), - (tmny - BBby),
        1.0, 1.0);

    fdx := fdx - (tmnx - BBlx);
    fdy := fdy - (tmny - BBby);
    end;

      dvilinepts (dviBBlx, dviBBby, dviBBrx, dviBBty, h, v);
      pgfigurenum := pgfigurenum + 1;

    (* We are ready to output the figure to the page *)
      writeln(logfile);
      write(logfile,'Figure #',pgfigurenum:0,' on page ',currpagenum:0,' is approx. ');
{      write(logfile,((globalsymlist^.BBty - globalsymlist^.BBby) div SPPERPT):0,' pts high and ');
      writeln(logfile,((globalsymlist^.BBrx - globalsymlist^.BBlx) div SPPERPT):0,' pts wide (actual size)');
}
    write(logfile,((tmxy - tmny) div SPPERPT):0,' pts high and ');
    writeln(logfile,((tmxx - tmnx) div SPPERPT):0,' pts wide (actual size)');
      IPUSH;

    end;

  while (pi <> nil) do
    begin
    with pi^ do
        begin
        case (kind) of
          Aline : begin
                 dvilinepts (lx1, ly1, lx2, ly2, h, v); (* DVI h and v posit *)
                 with globalsymlist^ do
                 linehandle (DoItNow, NoScale,
                                pi^.lx1, pi^.ly1, pi^.lx2, pi^.ly2,
                                0, 0,
                                pi^.itemthick, pi^.itemvec, pi^.itempatt,
                dviBBlx, dviBBrx, dviBBby, dviBBty,
                                fdx, -fdy, fsx, fsy, -figtheta);
                 end; (* Aline *)

         Aspline : begin
                   dvicontpts (spts, nsplknots, h, v);
                   with globalsymlist^ do
                   splinehandle (DoItNow, NoScale, pi^.spltype,
                   pi^.sclosed, pi^.dosmarks,
                                pi^.spts, pi^.nsplknots,
                                0, 0,
                                pi^.itemthick, pi^.itemvec, pi^.itempatt,
                                dviBBlx, dviBBrx, dviBBby, dviBBty,
                                fdx, -fdy, fsx, fsy, -figtheta);
                  end; (* Aspline *)

          Attspline : begin
                   dvicontpts (ttpts, nttknots, h, v);
                   with globalsymlist^ do
                   ttsplhandle (DoItNow, NoScale, pi^.tspltype,
                   pi^.tclosed, pi^.dottmarks,
                                pi^.ttpts, pi^.ttarry, pi^.nttknots,
                                0, 0,
                                pi^.itemvec, pi^.itempatt,
                                dviBBlx, dviBBrx, dviBBby, dviBBty,
                                fdx, -fdy, fsx, fsy, -figtheta);
                  end; (* Attspline *)

          Abeam : begin
                  dvilinepts (bx1, by1, bx2, by2, h, v);
                  beamhandle (DoItNow, staf, bkind, bx1, by1, bx2, by2);
                  end; (* Abeam *)

          Atieslur : begin
                     dvicontpts (tspts, ntknots, h, v);
                     tieslurhandle (DoItNow, tspts, ntknots, minth, maxth);
                     end;  (* a tie or slur *)

      Aarc : begin
                   dvicontpts (arcpts, narcknots + 1, h, v);
                   with globalsymlist^ do
                   arccirclehandle (DoItNow, NoScale,
                pi^.acentx, pi^.acenty,
                pi^.aradius,
                pi^.firstang, pi^.lastang,
                pi^.arcpts, pi^.narcknots,
                0, 0,
                pi^.itemthick, pi^.itemvec, pi^.itempatt,
                                dviBBlx, dviBBrx, dviBBby, dviBBty,
                fdx, -fdy, fsx, fsy, -figtheta);
           end; (* arc *)
      Alabel : begin
             null1 := 0; null2 := 0;
             dvilinepts (labx, laby, null1, null2, h, v);
           with globalsymlist^ do
           labelhandle (DoItNow, NoScale,
                   pi^.labx, pi^.laby,
                0, 0,
                pi^.fontstyle, pi^.labeltext,
                fdx, -fdy);
          end; (* label *)

          Afigure : begin (* recur *)
                    figurehandle (globalsymlist, pi, 0);
                    end; (* another symbol *)

        end; (* case *)
      end; (* with *)
    pi := pi^.nextitem;
    end; (* while *)
  if (dopush > 0) then
    begin
    IPOP;
    end;
end;  (*  figurehandle *)



(* %%% *)
{-----------------------------------------------------}
procedure mainhandlespecials (specnum, numpbytes : integer);
(* specnum is the DVI-number of the special
 * numpbytes is the number of parameter bytes
 *)
label 888;
const PARSLEN = 50;  (* Length of the byte-string-cache *)
      EMPTY = 0;
type charset = set of char;
var siz, numknots : integer;  (* Lots of temp vars that we use *)
     x1, y1, x2, y2 : integer;
     sx100, sy100 : real;
     transx, transy : ScaledPts;
     rot : real;
     SPscale : real;
     cpts : ControlPoints;
     thk : VThickness;
     patt : LineStyle;
     TTary : ThickAryType;
     vk : VectKind;
     bk : BeamKind;
     markdiam : integer;
     radius, ang1, ang2 : integer;
     phrase : strng;
     style : integer;
     nam : strng;
     sysnam : strng;    (* the first parameter of the \special *)
     let : char;
     i, gotten : integer;
     b : OctByt;
     pi : pItem;
     minx, miny, maxx, maxy : ScaledPts;
     maxthk, minthk : integer;

     tylnam,
     beginfigurenam,    (* names used for string to string comparisons *)
     endfigurenam,
     linenam,
     splinenam,
     ttsplnam,
     beamnam,
     tieslurnam,
     arcnam,
     labelnam,
     paramnam {internal} : charstring;

     splinetype : SplineKind;
     isclosedspline : boolean;

     parsearray : array [1..PARSLEN] of OctByt; (* cache of bytes to run through *)
     parsposit, parsmax : integer; (* current and max position in cache *)
     usingstream : boolean;    (* whether we read/parse using cache or from file *)


(*--------------------------------------------------------------
      These procedures depend on the correct ordering of
      GETs with respect to the number of bytes read in so far.
      precond: byte "b" has been read and gotten < numpbytes
      postcond: byte "b" has been read iff gotten < numpbytes.
      If your impl. definition of READ is non-standard, you will
      have to dink with the ordering and be really careful of
      keeping track of 'gotten' and 'numpbytes' variables
--------------------------------------------------------------*)

        function nextpbyte : integer;
        begin
          if (usingstream) then
            begin
            if (gotten < numpbytes) then
              begin
              nextpbyte := Dget1byte;
              gotten := gotten + 1;
              end
            else
              nextpbyte := EMPTY;
            end
          else
            begin (* not using stream *)
            if (parsposit <= parsmax) then
              begin
              nextpbyte := parsearray[parsposit];
              parsposit := parsposit + 1;
              end
            else
              begin     (* at end of parse array, so read from stream now *)
              usingstream := true;
              if (gotten < numpbytes) then
                begin
                nextpbyte := Dget1byte;
                gotten := gotten + 1;
                end
              else
                nextpbyte := EMPTY;
              end;
            end;  (* else *)
        end;

(* !!!!! Make sure all these predicates jive correctly with
    the key-letter definitions          *)
{__________________________________________________________________}
        function isanumber (b : integer) : boolean;
        begin
          isanumber :=  ((b >= xord['0']) and (b <= xord['9']));
        end;

        function isaletter (b : integer) : boolean;
        begin
          isaletter := (((b >= xord['A']) and (b <= xord['Z'])) or
                        ((b >= xord['a']) and (b <= xord['z'])) or
             (b = xord['@']) or
             (b = xord['"']) );
        end;

        function isaspace (b : integer) : boolean;
        begin
          isaspace := ((b = xord[' ']) or
                 (b = CR) or
               (b = LF) or
               (b = HT) or
               (b = FF));
        end;

        function isdelimiter (b : integer) : boolean;
        begin
          (* not a key-letter *)
          isdelimiter := (((b < xord['A']) or (b > xord['Z'])) and
                         ((b < xord['a']) or (b > xord['z'])) and
             (b <> xord['@']) and
             (b <> xord['"']) );
        end;

        function isnotnull (b : integer) : boolean;
        begin
          isnotnull := (b <> EMPTY);
        end;


{__________________________________________________________________}
        function getnumber : integer;
        var n : integer;
            isneg : boolean;
        begin
          n := 0;
          isneg := false;
          while (  (isnotnull (b)) and
                  (not (isanumber (b)))) do
            begin       (* not a numeral *)
            if (b = xord['-']) then
              isneg := true;
            b := nextpbyte;
            end;

      while (isaspace (b)) do  (* Skip spaces *)
        b := nextpbyte;

          while ( (isnotnull (b)) and
                 isanumber (b)) do
            begin (* a numeral *)
            n := n * 10 + (b - xord['0']);
            b := nextpbyte;
            end;

          if ((gotten = numpbytes)  and
                 isanumber (b)) then
            begin  (* end condition *)
            n := n * 10 + (b - xord['0']);
            end;

          if (isneg) then
            getnumber := -(n)
          else
            getnumber := n;
        end;
{__________________________________________________________________}

        function getletter : char;
        var k : char;
        begin
          k := ' ';
          while ( (isnotnull (b)) and
                   (isdelimiter (b) and not (isaspace (b)))) do
            begin (* non letter *)
            b := nextpbyte;
            end;

         if  ( (isnotnull (b)) and
                ( isaletter (b) or isaspace (b)
                 and not (isanumber (b)))) then
          begin
            k := xchr[b];
            b := nextpbyte;
          end;
        getletter := k;
        end;
{__________________________________________________________________}

        function getanything : char;
        var k : char;
        begin
          k := ' ';
          while (not (isnotnull (b))) do
            begin (* not usable *)
            b := nextpbyte;
            end;

         if (isnotnull (b)) then
          begin
            k := xchr[b];
            b := nextpbyte;
          end;
        getanything := k;
        end;

{****************************************************
   The following routines look for key - letter tokens
  that indicate certain attributes for a primitive.

Currently, the letters used are:
    S    for scaled-points measurement
    P    for printers points
    M    millimeters measurement
    C    use a Circular vector for drawing
    H    Horizontal-pen vector
    V    Vertical vector
    B    B-spline
    I    Interpolating B-spline
    K    Catmull-Rom spline
    D    Cardinal spline
    U    Open spline
    O    closed spline
    X    put marks on spline control pts
    T    Transformation marker
    R    Regular beam characters
    G    Grace Beam characters
    @    Specify center-point for arc/circle
    L    Line-style
    F    for beginfigure: Fit figure to wid/ht
    W    for beginfigure: figure was created at this wid & ht
**************************************************}


{__________________________________________________________________}
E_O_F
else
  echo "will not over write ./src/textyl.pas.ae"
fi
chmod 644 ./src/textyl.pas.ae
if [ `wc -c ./src/textyl.pas.ae | awk '{printf $1}'` -ne 30998 ]
then
echo `wc -c ./src/textyl.pas.ae | awk '{print "Got " $1 ", Expected " 30998}'`
fi
if `test ! -s ./src/h00vars.h`
then
echo "writing ./src/h00vars.h"
cat > ./src/h00vars.h << 'E_O_F'
/* Copyright (c) 1979 Regents of the University of California */

/* static char sccsid[] = "@(#)vars.h 1.12 1/22/83"; */

#include <stdio.h>

/*
 * px - Berkeley Pascal interpreter
 *
 * Version 4.0, January 1981
 *
 * Original version by Ken Thompson
 *
 * Substantial revisions by Bill Joy and Chuck Haley
 * November-December 1976
 *
 * Rewritten for VAX 11/780 by Kirk McKusick
 * Fall 1978
 *
 * Rewritten in ``C'' using libpc by Kirk McKusick
 * Winter 1981
 *
 * Px is described in detail in the "PX 4.0 Implementation Notes"
 * The source code for px is in several major pieces:
 *
 *    int.c        C main program which reads in interpreter code
 *    interp.c    Driver including main interpreter loop and
 *            the interpreter instructions grouped by their
 *            positions in the interpreter table.
 *    utilities.c    Interpreter exit, backtrace, and runtime statistics.
 *
 * In addition there are several headers defining mappings for panic
 * names into codes, and a definition of the interpreter transfer
 * table. These are made by the script make.ed1 in this directory and
 * the routine opc.c from ${PASCALDIR}. (see the makefile for details)
 */
#define PXPFILE        "pmon.out"
#define    BITSPERBYTE    8
#define    BITSPERLONG    (BITSPERBYTE * sizeof(long))
#define HZ        100
#define NAMSIZ        76
#define MAXFILES    32
#define PREDEF        2
#ifdef ADDR32
#define STDLVL        ((struct iorec *)(0x7ffffff1))
#define GLVL        ((struct iorec *)(0x7ffffff0))
#endif ADDR32
#ifdef ADDR16
#define STDLVL        ((struct iorec *)(0xfff1))
#define GLVL        ((struct iorec *)(0xfff0))
#endif ADDR16
#define FILNIL        ((struct iorec *)(0))
#define INPUT        ((struct iorec *)(&input))
#define OUTPUT        ((struct iorec *)(&output))
#define ERR        ((struct iorec *)(&_err))
#define    PX    0    /* normal run of px */
#define    PIX    1    /* load and go */
#define    PIPE    2    /* bootstrap via a pipe */
#define    PDX    3    /* invoked by the debugger "pdx" */
#define releq 0
#define relne 2
#define rellt 4
#define relgt 6
#define relle 8
#define relge 10
typedef enum {FALSE, TRUE} bool;

/*
 * interrupt and allocation routines
 */
extern long createtime;
extern char *PALLOC();
extern char *malloc();
extern long time();
extern intr();
extern memsize();
extern syserr();
extern liberr();

/*
 * stack routines and structures
 */
struct sze8 {
    char element[8];
};
extern short pop2();
extern long pop4();
extern double pop8();
extern struct sze8 popsze8();
extern char *pushsp();

/*
 * emulated pc types
 */
union progcntr {
    char *cp;
    unsigned char *ucp;
    short *sp;
    unsigned short *usp;
    long *lp;
    double *dbp;
    struct hdr *hdrp;
};

/*
 * THE RUNTIME DISPLAY
 *
 * The entries in the display point to the active static block marks.
 * The first entry in the display is for the global variables,
 * then the procedure or function at level one, etc.
 * Each display entry points to a stack frame as shown:
 *
 *        base of stack frame
 *          ---------------
 *          |        |
 *          | block mark  |
 *          |        |
 *          ---------------  <-- display entry "stp" points here
 *          |             |  <-- display entry "locvars" points here
 *          |   local    |
 *          |  variables  |
 *          |        |
 *          ---------------
 *          |        |
 *          |  expression |
 *          |  temporary  |
 *          |  storage    |
 *          |        |
 *          - - - - - - - -
 *
 * The information in the block mark is thus at positive offsets from
 * the display.stp pointer entries while the local variables are at negative
 * offsets from display.locvars. The block mark actually consists of
 * two parts. The first part is created at CALL and the second at entry,
 * i.e. BEGIN. Thus:
 *
 *        -------------------------
 *        |            |
 *        |  Saved lino        |
 *        |  Saved lc        |
 *        |  Saved dp        |
 *        |            |
 *        -------------------------
 *        |            |
 *        |  Saved (dp)        |
 *        |            |
 *        |  Pointer to current     |
 *        |   routine header info    |
 *        |            |
 *        |  Saved value of    |
 *        |   "curfile"        |
 *        |            |
 *        |  Empty tos value    |
 *        |            |
 *        -------------------------
 */

/*
 * program variables
 */
extern union display    _display;    /* runtime display */
extern struct dispsave    *_dp;        /* ptr to active frame */
extern long        _lino;        /* current line number */
extern int        _argc;        /* number of passed args */
extern char        **_argv;    /* values of passed args */
extern bool        _nodump;    /* TRUE => no post mortum dump */
extern long        _runtst;    /* TRUE => runtime tests */
extern long        _mode;        /* execl by PX, PIPE, or PIX */
extern long        _stlim;        /* statement limit */
extern long        _stcnt;        /* statement count */
extern long        _seed;        /* random number seed */
extern char        *_maxptr;    /* maximum valid pointer */
extern char        *_minptr;    /* minimum valid pointer */
extern long        *_pcpcount;    /* pointer to pxp buffer */
extern long        _cntrs;        /* number of counters */
extern long        _rtns;        /* number of routine cntrs */

/*
 * The file i/o routines maintain a notion of a "current file".
 * A pointer to this file structure is kept in "curfile".
 *
 * file structures
 */
struct iorechd {
    char        *fileptr;    /* ptr to file window */
    long        lcount;        /* number of lines printed */
    long        llimit;        /* maximum number of text lines */
    FILE        *fbuf;        /* FILE ptr */
    struct iorec    *fchain;    /* chain to next file */
    struct iorec    *flev;        /* ptr to associated file variable */
    char        *pfname;    /* ptr to name of file */
    short        funit;        /* file status flags */
    short        fblk;        /* index into active file table */
    long        fsize;        /* size of elements in the file */
    char        fname[NAMSIZ];    /* name of associated UNIX file */
};

struct iorec {
    char        *fileptr;    /* ptr to file window */
    long        lcount;        /* number of lines printed */
    long        llimit;        /* maximum number of text lines */
    FILE        *fbuf;        /* FILE ptr */
    struct iorec    *fchain;    /* chain to next file */
    struct iorec    *flev;        /* ptr to associated file variable */
    char        *pfname;    /* ptr to name of file */
    short        funit;        /* file status flags */
    short        fblk;        /* index into active file table */
    long        fsize;        /* size of elements in the file */
    char        fname[NAMSIZ];    /* name of associated UNIX file */
    char        buf[BUFSIZ];    /* I/O buffer */
    char        window[1];    /* file window element */
};

/*
 * unit flags
 */
#define    FDEF    0x80    /* 1 => reserved file name */
#define    FTEXT    0x40    /* 1 => text file, process EOLN */
#define    FWRITE    0x20    /* 1 => open for writing */
#define    FREAD    0x10    /* 1 => open for reading */
#define    TEMP    0x08    /* 1 => temporary file */
#define    SYNC    0x04    /* 1 => window is out of sync */
#define    EOLN    0x02    /* 1 => at end of line */
#define    EOFF    0x01    /* 1 => at end of file */

/*
 * file routines
 */
extern struct iorec    *GETNAME();
extern char        *MKTEMP();

/*
 * file record variables
 */
extern struct iorechd    _fchain;    /* head of active file chain */
extern struct iorec    *_actfile[];    /* table of active files */
extern long        _filefre;    /* last used entry in _actfile */

/*
 * standard files
 */
extern struct iorechd    input;
extern struct iorechd    output;
extern struct iorechd    _err;

/*
 * Px execution profile array
 */
#ifdef PROFILE
#define    NUMOPS 256
extern long _profcnts[NUMOPS];
#endif PROFILE
E_O_F
else
  echo "will not over write ./src/h00vars.h"
fi
chmod 644 ./src/h00vars.h
if [ `wc -c ./src/h00vars.h | awk '{printf $1}'` -ne 6978 ]
then
echo `wc -c ./src/h00vars.h | awk '{print "Got " $1 ", Expected " 6978}'`
fi
if `test ! -s ./src/textyl.pas.ah`
then
echo "writing ./src/textyl.pas.ah"
cat > ./src/textyl.pas.ah << 'E_O_F'

     strcopy (dvifname.str, logfilnam.str, dvifname.len);
     logfilnam.len := dvifname.len;
     rp := revindex (logfilnam, '.');
     (* add a ".tlog" extension *)
     i := rp - 1;
     logfilnam.str[i + 1] := '.';
     logfilnam.str[i + 2] := 't';
     logfilnam.str[i + 3] := 'l';
     logfilnam.str[i + 4] := 'o';
     logfilnam.str[i + 5] := 'g';
     logfilnam.len := i + 5;

     openlogfile;
end;


{-----------------------------------------------------}
    function inTFM (z: integer): boolean;
    label
        9997, 9998, 9999;
    var
        k: integer;
        lh: integer;
        nw: integer;
        alpha, beta: integer;
    begin
        readtfmword;
        lh := b2 * 256 + b3;
        readtfmword;
        font[nf].bc := b0 * 256 + b1;
        font[nf].ec := b2 * 256 + b3;
        if (font[nf].ec < font[nf].bc) then
            font[nf].bc := font[nf].ec + 1;
        readtfmword;
        nw := b0 * 256 + b1;
        if ((nw = 0) or (nw > 256)) then
            goto 9997;
        for k := 1 to 3 + lh do
          begin
            if eof(tfmfile) then
                goto 9997;
            readtfmword;
            if (k = 4) then
              if (b0 < 128) then
                tfmchecksum := ((b0 * 256 + b1) * 256 + b2) * 256 + b3
              else
                tfmchecksum := (((b0 - 256) * 256 + b1) * 256 + b2) * 256 + b3
          end;

            for k := 0 to (font[nf].ec - font[nf].bc) do
              begin
                readtfmword;
                if (b0 > nw) then
                    goto 9997;
                font[nf].widths[k] := b0
              end;
          alpha := 16 * z;
          beta := 16;
          while z >= TWO23 do
            begin
              z := z div 2;
              beta := beta div 2
            end;
        for k := 0 to nw - 1 do
          begin
            readtfmword;
            inwidth[k] := (((b3 * z) div 256 + b2 * z) div 256 + b1 * z) div beta;
            if b0 > 0 then
                if b0 < 255 then
                    goto 9997
                else
                    inwidth[k] := inwidth[k] - alpha;
          end;
        if inwidth[0] <> 0 then
            goto 9997;
        with font[nf] do
          begin
          for k := 0 to (ec - bc) do
            if widths[k] = 0 then
              begin
              widths[k + bc] := TWO31;
{              pixelwidths[k + bc] := 0;}
              end
            else
              begin
              widths[k + bc] := inwidth[widths[k]];
{              pixelwidths[k + bc] := round(conv * widths[k]);}
              end;
           end; (* with *)
        inTFM := true;
        goto 9999;
9997:
    complain (ERRREALBAD);
        writestrng(tfmname,true);
    writeln(logfile,'---not loaded, TFM file is bad');

9998:
        inTFM := false;
9999:

    end;



{-----------------------------------------------------}
procedure Fastdefinefont (fn: integer);
var     p, k: integer;
        n, waste: integer;
        c, q, d: integer;

begin  { Fastdefinefont }
  c := Dsign4byte;
  q := Dsign4byte;
  d := Dsign4byte;
  p := Dget1byte;
  n := Dget1byte;
  for k := 1 to (p + n) do
    waste := Dget1byte;
end;  { Fastdefinefont }


{-----------------------------------------------------}
    procedure definefont (e: integer);
    var
        f: 0..MAXFONTS;
        p, k: integer;
        n: integer;
        c, q, d: integer;
        r: integer;
    begin
        if (nf = MAXFONTS) then
        begin
      complain (ERRREALBAD);
          writeln(logfile,'TeXtyl capacity exceeded (max fonts=', MAXFONTS: 1, ')!');
          writeln('TeXtyl capacity exceeded (max fonts=', MAXFONTS: 1, ')!');
          jumpout
        end;
        font[nf].num := e;
        f := 0;
        while font[f].num <> e do  (* find first occurrence *)
            f := f + 1;
        c := Dsign4byte;
        font[nf].checksum := c;
        q := Dsign4byte;
        font[nf].scaledsize := q;
        d := Dsign4byte;
        font[nf].designsize := d;
        p := Dget1byte;
        n := Dget1byte;
        font[nf].name.len := p + n;
        for k := 1 to (p + n) do
           font[nf].name.str[k] := Dget1byte;

        if (f = nf) then
        begin (* f = nf *)
            for k := 1 to AREALENGTH do
                tfmname.str[k] := ' ';

              r := 0;

            for k := 1 to font[nf].name.len do
              begin
                r := r + 1;
                tfmname.str[r] := xchr[font[nf].name.str[k]]
              end;
            tfmname.str[r + 1] := '.';
            tfmname.str[r + 2] := 't';
            tfmname.str[r + 3] := 'f';
            tfmname.str[r + 4] := 'm';

        tfmname.str[r + 5] := chr(32);

        tfmname.len := r + 4;

            if (not opentfmfile) then
          begin
            complain (ERRREALBAD);
                writestrng(tfmname,true);
        writeln(logfile,'---not loaded, TFM file can''t be opened!');
        writestrng(tfmname, false);
        writeln(' cannot be opened. Aborting.');
        jumpout;
             end
            else
              begin
                if (q <= 0) or (q >= TWO27) then
          begin
            complain (ERRREALBAD);
                    writestrng(tfmname,true);
                    writeln(logfile,'---not loaded, bad scale (', q: 1, ')!');
          end
                else if (d <= 0) or (d >= TWO27) then
          begin
            complain (ERRREALBAD);
                    writestrng(tfmname,true);
                    writeln(logfile,'---not loaded, bad design size (', d: 1, ')!');
          end
                else
                  if inTFM(q) then
                    begin (* intfm *)
                    font[nf].space := q div 6;
                    if (c <> 0) and (tfmchecksum <> 0) and (c <> tfmchecksum) then
                      begin
                      writeln(logfile,'Problem in fig#',pgfigurenum:0,' on page ',currpagenum:0);
                  writestrng(tfmname,true);
                      writeln(logfile,'---beware: check sums do not agree!');
                      writeln(logfile,'   (', c: 1, ' vs. ', tfmchecksum: 1, ')');
                      end;
                    d := round(100.0 * conv * q / (trueconv * d));
                    nf := nf + 1;
                    font[nf].space := 0;
                    end (* intfm *)
                 end;
            end;
    end;

{-----------------------------------------------------}
    function firstpar (o: OctByt): integer;
    var fpar : integer;
    begin
       case (o) of
            0, 1, 2, 3, 4, 5, 6,
            7, 8, 9, 10, 11, 12, 13,
            14, 15, 16, 17, 18, 19, 20,
            21, 22, 23, 24, 25, 26, 27,
            28, 29, 30, 31, 32, 33, 34,
            35, 36, 37, 38, 39, 40, 41,
            42, 43, 44, 45, 46, 47, 48,
            49, 50, 51, 52, 53, 54, 55,
            56, 57, 58, 59, 60, 61, 62,
            63, 64, 65, 66, 67, 68, 69,
            70, 71, 72, 73, 74, 75, 76,
            77, 78, 79, 80, 81, 82, 83,
            84, 85, 86, 87, 88, 89, 90,
            91, 92, 93, 94, 95, 96, 97,
            98, 99, 100, 101, 102, 103, 104,
            105, 106, 107, 108, 109, 110, 111,
            112, 113, 114, 115, 116, 117, 118,
            119, 120, 121, 122, 123, 124, 125,
            126, 127:
                fpar := o - 0;
            128, 133, 235, 239, 243:
                fpar := Dget1byte;
            129, 134, 236, 240, 244:
                fpar := Dget2byte;
            130, 135, 237, 241, 245:
                fpar := Dget3byte;
            143, 148, 153, 157, 162, 167:
                fpar := Dsign1byte;
            144, 149, 154, 158, 163, 168:
                fpar := Dsign2byte;
            145, 150, 155, 159, 164, 169:
                fpar := Dsign3byte;
            131, 132, 136, 137, 146, 151, 156,
            160, 165, 170, 238, 242, 246:
                fpar := Dsign4byte;
            138, 139, 140, 141, 142, 247, 248,
            249, 250, 251, 252, 253, 254, 255:
                fpar := 0;
            147:
                fpar := w;
            152:
                fpar := x;
            161:
                fpar := y;
            166:
                fpar := z;
            171, 172, 173, 174, 175, 176, 177,
            178, 179, 180, 181, 182, 183, 184,
            185, 186, 187, 188, 189, 190, 191,
            192, 193, 194, 195, 196, 197, 198,
            199, 200, 201, 202, 203, 204, 205,
            206, 207, 208, 209, 210, 211, 212,
            213, 214, 215, 216, 217, 218, 219,
            220, 221, 222, 223, 224, 225, 226,
            227, 228, 229, 230, 231, 232, 233,
            234:
                fpar := o - 171
        end;
        firstpar := fpar;
    end;

{-----------------------------------------------------}
    function specialcases (o: OctByt; p: integer): boolean;
    label
        46, 44, 30, 9998;
    var
        pure: boolean;

    begin
        pure := true;
        if ((o < 157) or (o > 249)) then
          begin
        complain (ERRREALBAD);
            writeln(logfile, 'undefined command ', o: 1, '!');
            goto 30;
          end;
        case (o) of
            157, 158, 159, 160:
                begin
                    goto 44;
                end;
            161, 162, 163, 164, 165:
                begin
                    y := p;
                    goto 44;
                end;
            166, 167, 168, 169, 170:
                begin
                    z := p;
                    goto 44;
                end;
            171, 172, 173, 174, 175, 176, 177,
            178, 179, 180, 181, 182, 183, 184,
            185, 186, 187, 188, 189, 190, 191,
            192, 193, 194, 195, 196, 197, 198,
            199, 200, 201, 202, 203, 204, 205,
            206, 207, 208, 209, 210, 211, 212,
            213, 214, 215, 216, 217, 218, 219,
            220, 221, 222, 223, 224, 225, 226,
            227, 228, 229, 230, 231, 232, 233,
            234:
                begin
                    goto 46;
                end;
            235, 236, 237, 238:
                begin
                    goto 46;
                end;
            243, 244, 245, 246:
                begin
                    definefont(p);
                    goto 30;
                end;

            239, 240, 241, 242:
                begin   (* =========specials============= *)
                  mainhandlespecials (o, p);
                  goto 30;
                end;
            247:
                begin
          complain (ERRREALBAD);
                  writeln(logfile,'preamble command within a page!');
                  goto 9998;
                end;
            248, 249:
                begin
          complain (ERRREALBAD);
                  writeln(logfile,'postamble command within a page!');
                  goto 9998;
                end;
       (*     others:
                begin
                  write(' ', 'undefined command ', o: 1, '!');
                  goto 30;
                end
    *)
        end;
44:  (* label *)
        if (v > 0) and (p > 0) then
            if (v > TWO31 - p) then
            begin
                p := TWO31 - v
            end;
        if (v < 0) and (p < 0) then
            if ((-v) > (p + TWO31)) then
            begin
                p := -v - TWO31
            end;

        v := v + p;

        goto 30;
46:  (* label *)
        font[nf].num := p;
        curfont := 0;
        while font[curfont].num <> p do
            curfont := curfont + 1;
        goto 30 ;
9998:
        pure := false;
30:
        specialcases := pure;
    end;


{-----------------------------------------------------}
    function dopage : boolean;
    label
        41, 42, 43, 30, 9998, 9999;
    var
        o: OctByt;
        p, q: integer;

    begin
        curfont := nf;
     s := 0;
        h := 0;
        v := 0;
        w := 0;
        x := 0;
        y := 0;
        z := 0;

        ourxpos := 0;
    ourypos := 0;
    ourfontnum := (-1);
        while true do
          begin
            o := Dget1byte;
            p := firstpar(o);
            if eof(dvifile) then begin
                writeln(logfile, 'Bad DVI file: ', 'the file ended prematurely', '!');
                writeln('Bad DVI file: ', 'the file ended prematurely', '!');
                jumpout
            end;
            if o <= 131 then
              begin
                goto 41;
              end
            else
              begin
               if (o > 156) then
                 begin
                   if specialcases(o, p) then
                      goto 30
                   else
                      goto 9998;
                 end;

                case (o) of
                    133, 134, 135, 136:
                        begin
                          goto 41;
                        end;
                    132, 137:
                        begin
                            goto 42
                        end;
                    138:
                        begin
                            goto 30;
                        end;
                    139:
                        begin (* BOP *)
              complain (ERRREALBAD);
                          writeln(logfile, 'bop occurred before eop');
                          goto 9998; (* Fail *)
                        end;
                    140:
                        begin (* EOP *)
                            if (s <> 0) then
                  begin
                  complain (ERRREALBAD);
                              writeln(logfile, 'stack not empty at end of page (level ', s: 1, ')!');
                  end;
                if (multifigure <> 0) then
                  begin
                    complain (ERRBAD);
                    writeln(logfile,'Some figure definition not closed at end of page ', currpagenum:0,'!');
                  end;

                            write (currpagenum:0,']');
                            write (logfile,currpagenum:0,']');
                if ((currpagenum mod 10) = 0) then
                  writeln;
                            dopage := true;
                            goto 9999;
                        end;
                    141:
                        begin (* PUSH *)
                          with stack[s] do
                            begin
                            sh := h;
                            sv := v;
                            sw := w;
                            sx := x;
                            sy := y;
                            sz := z;
                            end; (* with *)
                          s := s + 1;
                          goto 30;
                        end;
                    142:
                        begin (* POP *)
                            if s = 0 then
                  begin
                  complain (ERRREALBAD);
                              writeln(logfile,'illegal pop at level zero!');
                  end
                            else
                  begin
                                s := s - 1;
                                with stack[s] do
                                  begin
                                  h := sh;
                                  v := sv;
                                  w := sw;
                                  x := sx;
                                  y := sy;
                                  z := sz;
                                  end;
                               end;
                            goto 30;
                        end;
                    143, 144, 145, 146:
                        begin
                            q := p;
                            goto 43
                        end;
                    147, 148, 149, 150, 151:
                        begin
                            w := p;
                            q := p;
                            goto 43
                        end;
                    152, 153, 154, 155, 156:
                        begin
                            x := p;
                            q := p;
                            goto 43
                        end;
                (*    others:
                        if specialcases(o, p) then
                            goto 30
                        else
                            goto 9998;
                                *)
                end; (* case *)
            end; (* else *)
41:   (* finish cmd to set/put a char *)
            if p < 0 then
                p := 255 - (-1 - p) mod 256
            else if p >= 256 then
                p := p mod 256;
            if (p < font[curfont].bc) or (p > font[curfont].ec) then
                q := TWO31
            else
                q := font[curfont].widths[p];
            if (q = TWO31) then
              begin
            complain (ERRREALBAD);
                writeln(logfile,'Character ', p:1,' invalid in font #',curfont:0);
              end;
            if o >= 133 then
                goto 30;
            if q = TWO31 then
                q := 0;
            goto 43;

42:  (* finish cmd to set/put rule *)
            q := Dsign4byte;
            if o = 137 then
                goto 30;
            goto 43 ;

43:  (*finish cmd that sets h += q *)
            if (h > 0) and (q > 0) then
                if (h > (TWO31 - q)) then
                  begin
                    q := TWO31 - h
                  end;
            if (h < 0) and (q < 0) then
                if ((-h) > (q + TWO31)) then
                  begin
                    q := (-h) - TWO31
                  end;

            h := h + q;
30:
        end;
9998:
        dopage := false;
9999:

    end;

{-----------------------------------------------------}
    procedure skippages;
    label
        9999;
    var
        p: integer;
        k: 0..255;
        downthedrain: integer;
    begin
        while true do
          begin
            if eof(dvifile) then
              begin
                writeln(logfile, 'Bad DVI file: ', 'the file ended prematurely', '!');
                write(' ', 'Bad DVI file: ', 'the file ended prematurely', '!');
                jumpout
              end;
            k := Dget1byte;
            p := firstpar(k);
            case (k) of
                139:
                    begin (* BOP *)
                        newbackptr := DVIMark + TotBytesWritten - 1;
            currpagenum := Dsign4byte; (* count[0] *)
                        for k := 1 to 9 do
                            waste := Dsign4byte; (* WAS count[k] := *)
                        downthedrain := Dsign4byte;
                        BackupInBuf (4);
                        cmdSigned (oldbackptr, 4);
                        oldbackptr := newbackptr;
                        write(' [');
                        write(logfile,' [');
                        goto 9999;
                    end;
                132, 137: (* RULE *)
                    downthedrain := Dsign4byte;
                243, 244, 245, 246:
                    begin
                        definefont(p);
                    end;
                239, 240, 241, 242: (* specials *)
                    begin
                        mainhandlespecials (k, p);
                    end;
                248:
                    begin (* POST *)
                        ourq := DVIMark + TotBytesWritten - 1;
                        inpostamble := true;
                        goto 9999
                    end;
              (*  others:
                    null
        *)
            end
        end;
    9999:

    end;

{-----------------------------------------------------}
    procedure readpostamble;
    var
        k: integer;
        p, q, m: integer;
        indx : integer;
    begin
        if (Dsign4byte <> numerator) then
            writeln(logfile,'Postamble',' numerator',' doesn''t match the preamble!');
        if (Dsign4byte <> denominator) then
            writeln(logfile,'Postamble',' denominator',' doesn''t match the preamble!');
        if (Dsign4byte <> mag) then
           begin
           writeln(logfile,'Postamble',' magnification',' doesn''t match the preamble!');
           end;
        maxv := Dsign4byte;
        maxh := Dsign4byte;
        maxs := Dget2byte;
        BackupInBuf (2);
        cmd2byte (maxs + 2); (* pretend the stack depth
                  * does not increase by
                  * more than two
                  *)

        totalpages := Dget2byte;
        repeat
            k := Dget1byte;
            if (k >= 243) and (k < 247) then
              begin
                p := firstpar(k);
                Fastdefinefont(p);
                k := 138;
              end
        until k <> 138; (* NOP *)

       (* here, backup 1, enter all our fonts and
        then output the 249 that we backed over *)
        BackupInBuf (1);
        for indx := 1 to MFontsDefd do
          begin
          with MFontTable[indx]^ do
            enterfont (DVIFontNum, Cksum, DesSize,
                       DesSize, FontName );
          end; (* for *)
        for indx := 1 to VFontsDefd do
          begin
          with VFontTable[indx]^ do
            enterfont (DVIFontNum, Cksum, DesSize,
                        DesSize, FontName);
          end;  (* for *)
    for indx := 1 to LFontsDefd do
      begin
      with LFontTable[indx]^ do
        enterfont (DVIFontNum, Cksum, DesSize,
                DesSize, FontName);
      end;
        cmd1byte(249);  (* post post *)

        if (k <> 249) then
            writeln(logfile,'byte ',k:0,' is not postpost!');
        q := Dsign4byte;
        BackupInBuf (4);
        cmd4byte (ourq);
        m := Dget1byte;
        if (m <> 2) then
            writeln(logfile,'identification should be ', 2: 1, '!');
        m := 223;
        while (m = 223) and not eof(dvifile) do
            m := Dget1byte;
        if not eof(dvifile) then
    begin
            writeln(' ', 'Bad DVI file: ', 'signature in should be 223', '!');
            writeln(logfile, 'Bad DVI file: ', 'signature in should be 223', '!');
            jumpout
        end;
    end;


(* MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN *)
begin (* main *)
    initialize;
    AskandOpenFiles;  (* ask for filenames of inputdvi and outputfil *)

    writeln(logfile, TylVersion,' for Berkeley Unix');

    write(logfile,'Reading File: ');
    writestrng(dvifname,true);
    writeln(logfile);


    p := Dget1byte;
    if (p <> 247) then
    begin
        write(' ', 'Bad DVI file: ', 'First byte isn''t start of preamble!', '!');
        writeln(logfile,'Bad DVI file: ', 'First byte isn''t start of preamble!', '!');
        jumpout
    end;
    p := Dget1byte;
    if (p <> 2) then
        writeln(logfile,'identification in byte 1 should be ', 2: 1, '!');
    numerator := Dsign4byte;
    denominator := Dsign4byte;
    if (numerator <= 0) then
    begin
        write(' ', 'Bad DVI file: ', 'numerator is ', numerator: 1, '!');
        writeln(logfile, 'Bad DVI file: ', 'numerator is ', numerator: 1, '!');
        jumpout
    end;
    if (denominator <= 0) then
    begin
        write(' ', 'Bad DVI file: ', 'denominator is ', denominator: 1, '!');
        writeln(logfile, 'Bad DVI file: ', 'denominator is ', denominator: 1, '!');
        jumpout
    end;
    conv := numerator / 254000.0 * (resolution / denominator);
    mag := Dsign4byte;
    if (mag <= 0) then
    begin
        write(' ', 'Bad DVI file: ', 'magnification is ', mag: 1, '!');
        writeln(logfile, 'Bad DVI file: ', 'magnification is ', mag: 1, '!');
        jumpout
    end;
    magfactor := mag / 1000.0;
    trueconv := conv;
    conv := trueconv * magfactor;
    p := Dget1byte;     (* the 'k' of the preamble *)
    while p > 0 do
    begin
        p := p - 1;
        waste := Dget1byte;
    end;

    skippages;
    if not inpostamble then
    begin
        while (maxpages > 0) do
          begin (* while *)
            maxpages := maxpages - 1;
            if (not dopage) then
              begin
                write(' ', 'Bad DVI file: ', 'page ended unexpectedly', '!');
                writeln(logfile, 'Bad DVI file: ', 'page ended unexpectedly', '!');
                jumpout
              end;
        (* now we are at an EOP ---end of page *)
        (*  flushout GDVIbuffer, and reset counters *)
{         writeln('EOP: bytes used= ',GDVIBuf.TotByteLen:0);  }
            WriteDVIBuf;
            ClearDVIBuf;
            multifigure := 0;
        pgfigurenum := 0;
            FTBDs := 0;
            didnewfonts := false;
            repeat
                k := Dget1byte;
                if (k >= 243) and (k < 247) then
                  begin (* fontdefs *)
                    p := firstpar(k);
                    definefont(p);
                    k := 138
                  end;
            until (k <> 138); (* nop *)

            if (k = 248) then
            begin
                inpostamble := true;
                ourq := DVIMark + TotBytesWritten - 1;
                goto 30
            end;

            if (k = 139) then  (* BOP *)
            begin
        newbackptr := DVIMark + TotBytesWritten - 1;
        currpagenum := Dsign4byte; (* Count[0] *)
        for k := 1 to 9 do
            waste := Dsign4byte; (* WAS count[k] := *)
        waste := Dsign4byte; (* backpointer *)
        BackupInBuf (4);
        cmdSigned (oldbackptr, 4);
        oldbackptr := newbackptr;
        write(' [');
        write(logfile,' [');
          end
        else
              begin (* NOT bop?? *)
        writeln('We did not find BOP when expected');
        writeln(logfile,'We did not find BOP when expected');
                jumpout;
              end;

        end; (* while *)
30:
    end; (* if not inpostamble *)
    if (not inpostamble) then
    skippages;
    waste := Dsign4byte; (* ptr to the last bop in file *)
    BackupInBuf (4);
    cmdSigned (oldbackptr, 4);
    readpostamble;
    WriteDVIBuf;

    while ((TotBytesWritten mod 4) <> 0) do
       OutputByte(223);  (* final signatures *)

    writeln;
    writeln(logfile);
    write ('Output written on ');
    writestrng(outname, false);
    write(' (',currpagenum:0,' page');
    if (currpagenum > 1) then
      write('s');
    writeln(', ',TotBytesWritten:0,' bytes).');

    write (logfile,'Output written on ');
    writestrng(outname, true);
    write(logfile,' (',currpagenum:0,' page');
    if (currpagenum > 1) then
      write(logfile,'s');
    writeln(logfile,', ',TotBytesWritten:0,' bytes).');

    write ('Log written on ');
    writestrng(logfilnam, false); writeln;
    write (logfile,'Log written on ');
    writestrng(logfilnam, true); writeln (logfile);
    writeln;
    writeln(logfile);
666:
    if (ErrorOccurred) then
      begin
        writeln;
        writeln('Some error(s) occurred. Please check Logfile for details');
        writeln('Assume that the outputfile is incorrect');
      end;
end.

E_O_F
else
  echo "will not over write ./src/textyl.pas.ah"
fi
chmod 644 ./src/textyl.pas.ah
if [ `wc -c ./src/textyl.pas.ah | awk '{printf $1}'` -ne 26804 ]
then
echo `wc -c ./src/textyl.pas.ah | awk '{print "Got " $1 ", Expected " 26804}'`
fi
echo "Finished archive 4 of 9"
exit